home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / colordh.exe / COLORTST.PAS < prev    next >
Pascal/Delphi Source File  |  1993-01-14  |  6KB  |  213 lines
  1. program colortst;
  2. uses objects,views,app,drivers,menus,dialogs,
  3.  
  4.      Color_app; {* <------- *}
  5.  
  6.  
  7. type
  8.   Ttest = object(Color_Application)    {* <------ *}
  9.             constructor init;
  10.             procedure InitMenuBar; virtual;
  11.             procedure HandleEvent (var Event:TEvent); virtual;
  12.           end;
  13.  
  14.  
  15. {**********************************************************************}
  16. procedure Color_Demo (Background : integer);
  17. var
  18.   Dialog  : COLOR_APP.PColor_Dialog;
  19.   R       : OBJECTS.TRect;
  20.   Control : word;
  21.   Ok_B    : COLOR_APP.PColor_Button;
  22. begin
  23.  
  24.   R.Assign(0,0,80,23);
  25.   Dialog := New(COLOR_APP.PColor_Dialog,       {* <------- *}
  26.                Init(R,'BUTTON/STATICTEXT COLOR DEMO '));
  27.   WITH Dialog^ DO
  28.   BEGIN
  29.     {Flags := Flags AND NOT VIEWS.wfClose;}
  30.  
  31. {$IFDEF Ver70}
  32.     {palette := DIALOGS.dpGrayDialog;  {bp7, p332}
  33.     {palette := DIALOGS.dpCyanDialog;  {bp7, p332}
  34.     {palette := DIALOGS.dpBlueDialog;  {bp7, p332}
  35.     Palette := Background;
  36. {$ENDIF}
  37.  
  38.     R.Assign(1,4,11,8);
  39.     Insert(New(PButton, Init(R,'PButton',VIEWS.cmYes,bfNormal)));
  40.  
  41.     R.Assign(27,1,45,2);
  42.     Insert(New(PStaticText,Init(R,'Normal StaticText')));
  43.  
  44.     R.Assign(11,2,34,3);
  45.     Insert(New(PColor_StaticText,Init(R,'Color StaticText Type 1',Button_Red)));
  46.  
  47.     R.Assign(41,2,64,3);
  48.     Insert(New(PColor_StaticText2,Init(R,'Color StaticText Type 2',Button_Red)));
  49.  
  50.  
  51.     R.Assign(11,4,21,8);
  52.     Insert(New(PColor_Button,   {* <--------------- *}
  53.                Init(R,'~B~lack',cmCancel,bfNormal,
  54.                                      Button_Black)));
  55.     R.Assign(21,4,31,8);
  56.     Insert(New(PColor_Button,Init(R,'Bl~u~e',cmOk,bfDefault,
  57.                                      Button_Dk_Blue)));
  58.     R.Assign(31,4,41,8);
  59.     Insert(New(PColor_Button,Init(R,'~G~reen',cmOk,bfDefault,
  60.                                      Button_Green)));
  61.     R.Assign(41,4,51,8);
  62.     Insert(New(PColor_Button,Init(R,'~C~yan',cmOk,bfDefault,
  63.                                      Button_Cyan)));
  64.     R.Assign(51,4,61,8);
  65.     Insert(New(PColor_Button,Init(R,'~R~ed',cmOk,bfDefault,
  66.                                      Button_Red)));
  67.     R.Assign(61,4,71,8);
  68.     Insert(New(PColor_Button,Init(R,'~M~agenta',cmOk,bfDefault,
  69.                                      Button_Purple)));
  70.  
  71.     R.Assign(1,9,11,13);
  72.     Insert(New(PColor_Button,Init(R,'~B~rown',cmYes,bfNormal,
  73.                                      Button_Brown)));
  74.     R.Assign(11,9,21,13);
  75.     Insert(New(PColor_Button,Init(R,'Lt Gre~y~',cmCancel,bfNormal,
  76.                                      Button_Grey)));
  77.     R.Assign(21,9,31,13);
  78.     Insert(New(PColor_Button,Init(R,'~D~k Grey',cmOk,bfDefault,
  79.                                      Button_Dk_Grey)));
  80.     R.Assign(31,9,41,13);
  81.     Insert(New(PColor_Button,Init(R,'~L~t Blue',cmOk,bfDefault,
  82.                                      Button_Lt_Blue)));
  83.     R.Assign(41,9,51,13);
  84.     Insert(New(PColor_Button,Init(R,'Lt Gre~n~',cmOk,bfDefault,
  85.                                      Button_Lt_Green)));
  86.     R.Assign(51,9,61,13);
  87.     Insert(New(PColor_Button,Init(R,'~L~t Cyan',cmOk,bfDefault,
  88.                                      Button_Lt_Cyan)));
  89.     R.Assign(61,9,71,13);
  90.     Insert(New(PColor_Button,Init(R,'Lt R~e~d',cmOk,bfDefault,
  91.                                      Button_Lt_Red)));
  92.  
  93.     R.Assign(1,14,11,18);
  94.     Insert(New(PColor_Button,Init(R,'Lt M~a~ge',cmYes,bfNormal,
  95.                                      Button_Lt_Purple)));
  96.     R.Assign(11,14,21,18);
  97.     Insert(New(PColor_Button,Init(R,'Yell~o~w',cmCancel,bfNormal,
  98.                                      Button_Yellow)));
  99.     R.Assign(21,14,31,18);
  100.     Insert(New(PColor_Button,Init(R,'~W~hite',cmOk,bfDefault,
  101.                                      Button_White)));
  102.  
  103.     R.Assign(31,14,51,18);
  104.     Ok_B := New(PColor_Button,         {* <--------- *}
  105.                   Init(R,'~S~hadowLess',cmYes,bfNormal,
  106.                                      Button_Color_Default));
  107.     Insert(Ok_B);
  108.     Ok_B^.Hide_Shadow;                 {* <--------- *}
  109.  
  110.   END; {with}
  111.  
  112.   Control := APP.Desktop^.ExecView(Dialog);
  113.  
  114.   DISPOSE (Dialog,Done);
  115. end; {color_demo}
  116.  
  117.  
  118.  
  119.  
  120. const
  121.    cmNow  = 100;
  122.    cmNow1 = 101;
  123.    cmNow2 = 102;
  124.  
  125. {**************************************************************************}
  126. procedure Push_Event (Cmd : word);
  127. var
  128.   Put_Event : TEvent;
  129. begin
  130.   with Put_Event do
  131.   begin
  132.     What    := evCommand;
  133.     Command := Cmd;
  134.     InfoPtr := nil;
  135.   end; {with}
  136.   {*------------------------------------------------------*}
  137.   {* put it on the Event Schedule Queue                   *}
  138.   {*------------------------------------------------------*}
  139.   DeskTop^.PutEvent (Put_Event);
  140. end; {Push_Event}
  141.  
  142.  
  143. {**************************************************************************}
  144. constructor Ttest.Init;
  145. begin
  146. {$IFDEF Ver60}
  147.   Color_Application.Init;
  148. {$ELSE}
  149.   Inherited init;
  150. {$ENDIF}
  151.   Push_Event (cmNow);
  152.  
  153. end; {init}
  154.  
  155.  
  156. {**************************************************************************}
  157. procedure Ttest.InitMenuBar;
  158. var R:TRect;
  159. begin
  160.     GetExtent(R);
  161.     R.B.Y := R.A.Y +1;
  162.     MenuBar:= New(PMenuBar, Init(R, NewMenu(
  163.       NewSubMenu('~S~ee It',hcNoContext, NewMenu(
  164.         NewItem('~S~how Gray Dialog', 'F2', kbF2, cmNow, hcNoContext,
  165. {$IFDEF Ver60}
  166.         nil)),
  167. {$ELSE}
  168.         NewItem('~S~how Blue Dialog', 'F3', kbF3, cmNow1, hcNoContext,
  169.         NewItem('~S~how Cyan Dialog', 'F4', kbF4, cmNow2, hcNoContext,
  170.         nil)))),
  171. {$ENDIF}
  172.         nil)
  173.       )));
  174. end; {initmenubar}
  175.  
  176.  
  177. {**************************************************************************}
  178. procedure Ttest.HandleEvent(var Event: TEvent);
  179. var
  180.   dont_care : longint;
  181. begin {HandleEvent}
  182. {$IFDEF Ver60}
  183.   Color_Application.HandleEvent (Event);
  184. {$ELSE}
  185.   inherited HandleEvent(Event);
  186. {$ENDIF}
  187.  
  188.   case Event.What of
  189.     evCommand:
  190.       begin
  191.         case Event.Command of
  192.           cmNow : Color_Demo (2);
  193.           cmNow1: Color_Demo (0);  {* BP 7.0 *}
  194.           cmNow2: Color_Demo (1);  {* BP 7.0 *}
  195.         else
  196.           Exit;
  197.         end;
  198.         ClearEvent(Event);
  199.       end;
  200.   end;
  201.  end; {HandleEvent}
  202.  
  203. {***********************************************************************}
  204. var
  205.   test: Ttest;
  206.  
  207. begin
  208.   test.init;
  209.   test.run;
  210.   test.done;
  211. end. {end colortst}
  212.  
  213.